home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMPILER / VP10B003 / VPC / SOURCE / RTL / XCPT.PAS < prev   
Pascal/Delphi Source File  |  1995-06-21  |  3KB  |  64 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Runtime Library.  Version 1.0.    █}
  4. {█      Exception handling unit                          █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995 B&M&T Corporation             █}
  7. {█      ─────────────────────────────────────────────────█}
  8. {█      Written by Vitaly Miryanov                       █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11. {$S-,R-,Q-,I-,Cdecl-,OrgName-,AlignRec-}
  12.  
  13. unit Xcpt;
  14.  
  15. interface
  16.  
  17. function SetExceptionHandler(Handler: Pointer): Boolean;
  18.  
  19. implementation
  20.  
  21. uses Os2Base, Use32;
  22.  
  23. type
  24.   PXcptHandlers = ^TXcptHandlers;
  25.   TXcptHandlers = array [1..25] of ExceptionRegistrationRecord;
  26.  
  27. { Setups OS/2 exception handler. OS/2 DosSetExceptionHandler function   }
  28. { should not be used directly because exception registration record     }
  29. { must be on stack all time the thread's code is executed. Multiple     }
  30. { threads are not yet supported so this procedure cares about thread 1. }
  31. { Startup code of the SYSTEM unit allocates space on stack for 25       }
  32. { exception registration records and setups system exception handler,   }
  33. { so space for 24 user exception handlers is available. Array of        }
  34. { exception registration records grows backward (from last element to   }
  35. { first), because each handler's exception registration record must have}
  36. { a lower address than exception registration record of the previously  }
  37. { installed handler.                                                    }
  38.  
  39. { For a example of SetExceptionHandler usage see source file of the     }
  40. { CRT unit (CRT.PAS).                                                   }
  41.  
  42. function SetExceptionHandler(Handler: Pointer): Boolean;
  43. var
  44.   I: Integer;
  45.   P: PExceptionRegistrationRecord;
  46. begin
  47.   SetExceptionHandler := False;
  48.   if (XcptHandlers <> nil) and (XcptHandlerCount < High(TXcptHandlers)) then
  49.   begin
  50.     for I := High(TXcptHandlers) downto
  51.              High(TXcptHandlers) - XcptHandlerCount + 1 do
  52.       if @PXcptHandlers(XcptHandlers)^[I].ExceptionHandler = Handler
  53.         then Exit;
  54.     P := @PXcptHandlers(XcptHandlers)^[High(TXcptHandlers)-XcptHandlerCount];
  55.     Inc(XcptHandlerCount);
  56.     P^.ExceptionHandler := Err(Handler);
  57.     P^.Prev_Structure := nil;
  58.     DosSetExceptionHandler(P^);
  59.     SetExceptionHandler := True;
  60.   end;
  61. end;
  62.  
  63. end.
  64.